GS <- mutate(GS,Date = as.Date(Date, format = "%d-%b-%y"))
GSxts <- tk_xts(GS)
## Warning in tk_xts_.data.frame(data = data, select = select, date_var =
## date_var, : Non-numeric columns being dropped: Date
## Using column `Date` for date_var.
allDates = index(GSxts)
firstDate <- min(allDates)
lastDate <- max(allDates)-30 #find the last start_date
while(!lastDate %in% allDates)
  lastDate <- lastDate-1

result <- data.frame(`StartDate` = as.Date(character()), `OptionPnL` = double(), `HedgingPnL` = double(), `FinalPnL` = double(), `MaxDrawdown` = double(), `SharpeRatio` = double(),`StartPrice`= double(), `EndPrice` = double(), `AvgPrice` = double(), `AvgGrowthRate` = double(), `Volatility` = double(), `Profitability` = double())

startD <- firstDate
for(startD in firstDate:lastDate){
  startD <- as.Date(startD)
  if(startD %in% allDates){
    endD <- startD+30
    #adjust the end date backwards if end date (a calendar day) is not in the xts
    while(!endD %in% allDates)
      endD <- endD-1
    
    xts_obj <- GSxts[paste(c(startD,endD),collapse = "/")]
    
    quantity = 100
    dates <- index(xts_obj)
    start_date <- min(dates)
    end_date <- max(dates)
    start_price <- as.numeric(xts_obj[start_date, "Close"])
    start_volatility <- as.numeric(xts_obj[start_date, "IV30"])
    
    df <- tibble(Date = dates)
    df$Close <- coredata(xts_obj[, "Close"])
    #df$IV30 <- coredata(xts_obj[, "IV30"])
    avgChange <- as.numeric(mean(xts_obj[, "PChg"],na.rm=TRUE))
    r <- 0.8 / 100
    X <- start_price/(exp(qnorm(0.25)*start_volatility/100*sqrt(30/365) - (r+0.5*(start_volatility/100)^2)*30/365))
    #sigma = start_volatility
    
    # Vary S and Time everyday
    #S <- df$Close
    #Time <- (end_date - df$Date) / 365
    
    #GBSOption(TypeFlag, S, X, Time, r, b, sigma)@price
    
    df_opt <- rowwise(df) %>%
    #this is the premium for one unit of call option  
    mutate(premium = GBSOption(TypeFlag = "c",
    S = Close,
    X = X,
    Time = as.numeric((end_date - Date) / 365),
    r = r, # interest rate
    b = 1.85/100, # dividend yield obtained from https://www.dividend.com/dividend-stocks/financial/investment-brokerage-national/gs-goldman-sachs/
    sigma = as.numeric(start_volatility/100))@price,
    
    #this is the delta of a call option (before negation)
    delta_hedge = GBSGreeks("delta", TypeFlag = "c", 
                            S = Close, 
                            X = X, 
                            Time = as.numeric((end_date - Date) / 365), 
                            r = r, 
                            b = 1.85/100, 
                            sigma = as.numeric(start_volatility/100))) %>%
    ungroup() %>%
      
    #delta hedging strategy selected: SHORT CALL LONG STOCK (from BlackS Scholes formula, such strategy should approximate a long position in risk free)
    mutate(Option_DoD_PnL = ifelse(Date == start_date, # On the 1st date, we count the cost of buying the option
    0, #quantity*premium, #on the first day, receive the call option premium and short the option
    -quantity*(premium - Lag(premium))), #if subsequently call option price rises, there is a loss
    
    Hedging_DoD_Pnl = ifelse(Date == start_date, 0, quantity * Lag(delta_hedge) * (Close - Lag(Close))),
                             
    
    DoD_PnL = Option_DoD_PnL + Hedging_DoD_Pnl) %>%
    mutate(PortValue = quantity*(-premium + delta_hedge*Close),
           Profitability = DoD_PnL/Lag(PortValue),
           PnL_to_date = cumsum(DoD_PnL),
           HPnL_to_date = cumsum(Hedging_DoD_Pnl), 
           OPnL_to_date = cumsum(Option_DoD_PnL))
    
    maxDrawDown <- {
    xs <- df_opt$PnL_to_date
    max(cummax(xs) - cummin(xs))
    }
    
    #The initial outflow of funds is the cost to buy stocks minus option premium received 
    #InitialInvt = (df_opt[[1,"delta_hedge"]]*df_opt[[1,"Close"]] - df_opt[[1,"premium"]])*quantity #OUTFLOW of funds
    #profitability = df_opt[df_opt$Date==end_date,"PnL_to_date"]/InitialInvt
    #df_opt<-mutate(df_opt, PortValue = InitialInvt + PnL_to_date, PortReturn = DoD_PnL/Lag(PortValue))
    
    #ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Option_DoD_PnL),color = "blue") + ggtitle("option profit - TTM"))
    #ggplotly(p=ggplot(df_opt) + geom_line(aes(TTM,Hedging_DoD_Pnl))+ggtitle("stock profit - TTM"))
    
    #renderTable(tail(df_opt,1))
    
    
    #renderText(paste0("the Sharpe Ratio is ",round(SR,4)))
    #renderText(paste0("The maximum drawdown is ", round(maxDrawDown,4)))
    hedgingPnl <- as.numeric(df_opt[df_opt$Date==end_date,"HPnL_to_date"])
    finalPnl <- as.numeric(df_opt[df_opt$Date==end_date,"PnL_to_date"])
    optionPnl <- as.numeric(df_opt[df_opt$Date==end_date,"OPnL_to_date"])
    endPrice <- as.numeric(df_opt[df_opt$Date==end_date,"Close"])
    avgPrice <- as.numeric(mean(df_opt$Close,na.rm=TRUE))
    volatility <- stdev(df_opt$Profitability, na.rm = TRUE)*sqrt(252) #annualised volatility
    profitability <- 12*(as.numeric(tail(cumprod(na.omit(df_opt$Profitability+1)),1))-1) #annualized profitability
    SR <- as.numeric((profitability-r)/volatility) #  annual SR
    result <- rbind(result,data.frame("StartDate" = start_date, "OptionPnL" = optionPnl, "HedgingPnL" = hedgingPnl, "FinalPnL" = finalPnl, "MaxDrawdown" = maxDrawDown, "SharpeRatio" = SR,"StartPrice"=start_price , "EndPrice" = endPrice, "AvgPrice" = avgPrice, "AvgGrowthRate" = avgChange, "Volatility" = volatility, "Profitability" = profitability))
    
  }}
    ggplotly(p = ggplot(GS) + geom_line(aes(Date, Close, label = PChg))+ggtitle("Stock Price with percentage change")) #stock close price
## Warning: Ignoring unknown aesthetics: label
    ggplot(GS) + geom_density(aes(Close)) #density of close price

    ggplot(result) + geom_density(aes(MaxDrawdown)) + ggtitle("distribution of max drawdown")

    kable(result%>% summarise(`MDD Mean` = mean(MaxDrawdown),`MDD volatility` = stdev(MaxDrawdown, na.rm = TRUE), `MDD Median` = median(MaxDrawdown))) %>% kable_styling(bootstrap_options = c("striped","hover"))
MDD Mean MDD volatility MDD Median
162.8201 156.6738 110.0302 
    kable(result%>% summarise(`Mean Profitability` = mean(Profitability),`volatility` = stdev(Profitability, na.rm = TRUE), `Mean PnL` = mean(FinalPnL), `PnL StdDev` = stdev(FinalPnL))) %>% kable_styling(bootstrap_options = c("striped","hover"))
Mean Profitability volatility Mean PnL PnL StdDev
-0.6710013 2.381391 -17.81155 200.1258 
    kable(result%>% summarise(`99% VAR` = -min(quantile(FinalPnL,.01),0),`95% VAR` = -min(quantile(FinalPnL,0.05),0))) %>% kable_styling(bootstrap_options = c("striped","hover"))
99% VAR 95% VAR
676.3717 429.1349 
    ggplot(result) + geom_density(aes(FinalPnL),color = "blue") + 
      geom_density(aes(OptionPnL),color = "red") + 
      geom_density(aes(HedgingPnL))

    ggplotly(p=ggplot(result) + geom_point(aes(AvgPrice,FinalPnL, label = StartDate)) + ggtitle("avg price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
    ggplotly(p=ggplot(result) + geom_point(aes(AvgGrowthRate,FinalPnL, label = AvgPrice))+ggtitle("avg growth rate - final pnl"))
## Warning: Ignoring unknown aesthetics: label
    ggplotly(p=ggplot(result) + geom_point(aes(StartPrice,FinalPnL, label = EndPrice))+ggtitle("start price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
    ggplotly(p=ggplot(result) + geom_point(aes(EndPrice,FinalPnL, label = StartPrice))+ggtitle("end price - final pnl"))
## Warning: Ignoring unknown aesthetics: label
    p1 <- ggplot(result) + geom_point(aes(AvgPrice, OptionPnL)) + ggtitle("avg price - option pnl") #+ xlim(150,300) + ylim(150,300) + coord_fixed(ratio = 1)
    p2 <- ggplot(result) + geom_point(aes(AvgPrice, HedgingPnL)) + ggtitle("avg price - hedging pnl") #+ xlim(150,300) + ylim(150,300) + coord_fixed(ratio = 1)
    grid.arrange(p1,p2,nrow = 1)

    a1 <- ggplot(result) + geom_point(aes(AvgGrowthRate,OptionPnL)) + 
      ggtitle("avg growth rate - option pnl")
    a2 <- ggplot(result) + geom_point(aes(AvgGrowthRate,HedgingPnL)) + 
      ggtitle("avg growth rate - hedging pnl")
    grid.arrange(a1,a2, nrow = 1)

The PnLs have greater dispersion when average price or average growth rate (represented in percentage) increases. The PnL can be very extreme towards the higher end of the growth rate. Option PnL is more cluttered when growth rate is at level (-1,0.5) compared with hedging PnL at the same growth level, which suggests that the risk may not be perfectly hedged.

    a3 <- ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = OptionPnL), size = 0.8, alpha = 0.7)+ggtitle("start & end price - option pnl") + xlim(150,280) + ylim(150,280) + coord_fixed(ratio = 1) + geom_abline(mapping = NULL, data = NULL, slope = 1, intercept = 0, show.legend = NA)
    a4 <- ggplot(result) + geom_point(aes(x = StartPrice, y = EndPrice, color = HedgingPnL), size = 0.8, alpha = 0.7)+ggtitle("start & end price - hedging pnl") + xlim(150,280) + ylim(150,280) + coord_fixed(ratio = 1) + geom_abline(mapping = NULL, data = NULL, slope = 1, intercept = 0, show.legend = NA)
     grid.arrange(a3,a4, nrow=1)

The graph plots start and end price on x and y axis respectively, so points lying on the 45 degree line represents a trade with start price equals end price. The color represents the Option and Hedging PnL. From the color of the points, it is easy to observe the hedging relationship. When the points are below the line (decreasing price), the option PnL is more favourable (since we have a short position in the call option), and hedging PnL is more negative.

When using 0.25 delta, we get a smaller final pnl, this is because the OTM options are cheaper and we need less stocks to hedge against them. It could also be observed that the option and hedging PnLs in a single trade with 25% delta fluctuate less violently or regularly against Time to Maturity as compared to ATM options in the other backtesting.

     kable(head(result,20))%>%
  kable_styling(bootstrap_options = c("striped","hover"))
StartDate OptionPnL HedgingPnL FinalPnL MaxDrawdown SharpeRatio StartPrice EndPrice AvgPrice AvgGrowthRate Volatility Profitability
2017-12-13 220.07269 -118.91429 101.158403 104.07377 8.9203529 255.56 257.03 256.1119 -0.0000952 0.0663122 0.5995284
2017-12-14 210.73508 -118.68985 92.045229 100.13937 8.3767367 255.48 257.03 256.1395 0.0003000 0.0678813 0.5766238
2017-12-15 204.73691 -131.04002 73.696886 85.70971 7.7983277 257.17 257.03 256.1742 0.0003158 0.0727218 0.5751083
2017-12-18 227.06058 -168.83876 58.221825 81.15563 3.7267474 260.02 253.65 256.1125 -0.0007000 0.0977887 0.3724337
2017-12-19 232.23490 -104.43415 127.800750 150.62884 3.0696009 256.48 250.97 255.6600 -0.0018000 0.0971778 0.3062969
2017-12-20 234.13694 -87.85054 146.286397 187.23015 5.1474553 255.18 256.12 255.6420 -0.0000500 0.1144111 0.5969261
2017-12-21 232.49260 -138.30495 94.187646 95.18190 5.7176805 261.01 256.12 255.6663 0.0002105 0.1203810 0.6962998
2017-12-22 222.55065 -107.00116 115.549498 118.48262 5.5107281 258.97 256.12 255.3694 -0.0010556 0.1228965 0.6852494
2017-12-26 235.43117 -70.69340 164.737772 164.73777 3.1683852 257.72 269.03 256.8571 0.0018571 0.1244430 0.4022834
2017-12-27 149.65258 10.85251 160.505091 160.50509 0.7960612 255.95 268.14 257.3533 0.0019524 0.0959786 0.0844049
2017-12-28 198.89344 -17.43462 181.458827 181.45883 0.8937680 256.50 268.14 257.4235 0.0024000 0.1029339 0.0999990
2017-12-29 59.49473 79.87808 139.372816 139.37282 1.1329398 254.76 268.14 257.4721 0.0024211 0.0892215 0.1090826
2018-01-02 -308.80497 314.63071 5.825741 90.05975 -0.6058037 255.67 272.23 259.9432 0.0030909 0.0518000 -0.0233806
2018-01-03 221.18366 -625.92119 -404.737529 488.74674 -3.2998058 253.29 260.04 260.1418 0.0008636 0.0671042 -0.2134307
2018-01-04 223.80131 -878.58409 -654.782785 751.21048 -2.8776041 256.83 260.04 260.4681 0.0013333 0.1149614 -0.3228134
2018-01-05 216.73966 -820.74671 -604.007054 698.35992 -2.7324602 255.52 260.04 260.6500 0.0007000 0.1047276 -0.2781640
2018-01-08 226.99296 -717.95016 -490.957200 565.11316 -3.4482601 251.81 257.10 260.1086 0.0004091 4.1513772 -14.3070284
2018-01-09 235.04055 -675.11801 -440.077454 506.39067 -3.6957450 253.94 246.35 259.8605 -0.0008182 1.8943881 -6.9931753
2018-01-10 234.37942 -689.31819 -454.938769 510.65330 -3.9136773 254.33 249.30 259.6495 -0.0006364 1.0960271 -4.2814965
2018-01-11 235.13630 -637.13524 -401.998937 460.96559 -3.8721516 255.13 249.30 259.9029 -0.0007619 1.0314277 -3.9858445